home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / DELPHI / COMPRESS.ZIP / ARC2MEM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-02  |  4.9 KB  |  124 lines

  1. (* ARC2MEM.PAS V2.0
  2.  
  3. This code is designed to be dropped into the COMPDEMO application, adding
  4. one new routine (LoadArchivedFileToMemory) and replacing two existing ones
  5. (CDBImage1DragDrop and CDBMemo1DragDrop).
  6.  
  7. It gives an idea of a more efficient way to load compressed data from
  8. a file archive to a blob field, without using an intermediate file as
  9. COMPDEMO currently does.
  10.  
  11. However, it still decompresses the data on the way, so the most efficient
  12. approach is that shown ARC2BLOB.PAS which transfers the UNcompressed data
  13. as-is to a target compressed blob.
  14.  
  15. Keep in mind that both this and the ARC2BLOB code require manipulation of some
  16. of the TCompress data structures...
  17.  
  18. *)
  19.  
  20.  
  21. { Example of Expanding a file DIRECTLY from an archive to another stream }
  22. procedure TForm1.LoadArchivedFileToMemory(var mem:Tmemorystream;filepath:String);
  23. var fs: TFilestream; { here we go... }
  24.     cfinfo: TCompressedFileInfo;
  25.     fheader: TCompressedFileHeader;
  26. begin
  27.   cfinfo := TCompressedFileInfo(FileList.objects[FileList.indexof(filepath)]);
  28.   fs:=TFileStream.Create(archivefile.text,fmOpenRead or fmShareExclusive); { just want to READ it... }
  29.   try
  30.      fs.seek(cfinfo.Position,0);        { find the file info start }
  31.      fs.read(fheader,sizeof(fheader));  { read the header }
  32.      fs.seek(fheader.filenameLength,1); { and skip the filename -- now at compressed data start }
  33.      mem.SetSize(cfinfo.FullSize);      { pre-set the size for fastest/cleanest results }
  34.      Compress1.DoExpand(mem,fs,cfinfo.CompressedSize,cfinfo.Fullsize, cfinfo.Checksum,
  35.                  cfinfo.CompressedMode,'');
  36.   finally
  37.      fs.free
  38.   end;
  39. end;
  40.  
  41. { Examples of setting/loading/shifting image blobs using the above routine }
  42. procedure TForm1.CDBImage1DragDrop(Sender, Source: TObject; X, Y: Integer);
  43. var filepath: String;
  44.      mem: TMemoryStream; { for loading image from an archived file }
  45. begin
  46.    if Source=Sender then exit; { nowt to do }
  47.    if (Sender is TCDBImage) and (not Table1.active) then
  48.    begin
  49.      showmessage('Can''t do this unless table has been opened...');
  50.      exit;
  51.    end;
  52.  
  53.   Screen.Cursor := crHourGlass;
  54.   if (Source is TImage) and (Sender is TCDBImage) then
  55.      CDBImage1.picture.bitmap.Assign(Image1.Picture.bitmap)
  56.   else if (Source is TCDBImage) and (Sender is TImage) then
  57.      Image1.picture.bitmap.Assign(CDBImage1.Picture.Bitmap)
  58.   else
  59.   begin   { Have we got an image? }
  60.      filepath := '';
  61.      if (Source is TListBox) and (Listbox1.selcount = 1) then
  62.       filepath:=ListBox1.Items[Listbox1.ItemIndex] { archive list }
  63.      else if (Source is TFileListBox) and (FL.selcount=1) then
  64.         filepath:=FL.Items[FL.ItemIndex]; { file list }
  65.      if ExtractFileExt(filepath)<>'.bmp' then
  66.         showmessage('Must be a .BMP file...')
  67.      else                                     { ok, here we go... }
  68.         if Source is TFileListBox then { just load from file... }
  69.           if Sender is TImage then
  70.              Image1.Picture.Bitmap.LoadFromfile(filepath)
  71.           else
  72.              CDBImage1.Picture.Bitmap.LoadFromFile(filepath)
  73.         else { source must be our archive file... }
  74.         begin
  75.            mem:= TMemoryStream.create;
  76.            try
  77.              LoadArchivedFileToMemory(mem,filepath);
  78.              mem.seek(0,0);
  79.              if Sender is TImage then
  80.                Image1.Picture.Bitmap.LoadFromStream(mem)
  81.              else
  82.                CDBImage1.Picture.Bitmap.LoadFromStream(mem);
  83.            finally
  84.               mem.free
  85.            end;
  86.         end;
  87.   end;
  88.   if Table1.active and (Table1.State in [dsEdit]) then Table1.post; { save immediately if updated }
  89.   if not Image1.Picture.Bitmap.Empty then Memo1.visible := False; { got a piccy showing... }
  90.   Screen.Cursor := crDefault;
  91. end;
  92.  
  93. { Examples of setting/loading/shifting Memo blobs using LoadArchivedFileToMemory }
  94. procedure TForm1.CDBMemo1DragDrop(Sender, Source: TObject; X, Y: Integer);
  95. var filepath: String;
  96.      mem: TMemoryStream; { for loading text from an archived file }
  97. begin
  98.   filepath := ''; { in case fails }
  99.   if (Source is TListBox) and (Listbox1.selcount = 1) then
  100.    filepath:=ListBox1.Items[Listbox1.ItemIndex] { archive list }
  101.   else if (Source is TFileListBox) and (FL.selcount=1) then
  102.      filepath:=FL.Items[FL.ItemIndex]; { file list }
  103.   if ExtractFileExt(filepath)<>'.txt' then
  104.      showmessage('Must be a .TXT file...')
  105.   else begin                     { ok, here we go... }
  106.     Screen.Cursor := crHourGlass;
  107.    if Source is TFileListBox then
  108.      CDBMemo1.Lines.LoadfromFile(filepath)
  109.    else
  110.    begin
  111.      mem:= TMemoryStream.create;
  112.      try
  113.        LoadArchivedFileToMemory(mem,filepath);
  114.        mem.seek(0,0);
  115.        CDBMemo1.Lines.LoadfromStream(mem)
  116.      finally
  117.         mem.free
  118.      end;
  119.    end;
  120.   end;
  121.   if Table1.active and (Table1.State in [dsEdit]) then Table1.post; { save immediately if updated }
  122.   Screen.Cursor := crDefault;
  123. end;
  124.